home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byt86aug.arc / NORMAL.SRC < prev    next >
Text File  |  1980-01-01  |  1KB  |  53 lines
  1. Program Normal;
  2.  
  3.  Var I : Integer;
  4.      Y1, Y2 : Real;
  5.      Freq : Array[0..30] of Integer;
  6.  
  7.  Procedure Initialize;
  8.    Var I : integer;
  9.    Begin
  10.      For i:= 0 to 30 do Freq[i] := 0
  11.    End;
  12.  
  13.  
  14.  Procedure Classify (Y: Real);
  15.    Const MinY = -3.5;
  16.          YRange = 7.0;
  17.          NbClasses = 30;
  18.    Var Temp : Integer;
  19.    Begin
  20.      Temp := Trunc((Y-MinY)/YRange*NbClasses);
  21.      If Temp < 1 then Temp := 0
  22.                  else if Temp > NbClasses then Temp := 
  23.                  NbClasses;
  24.      Freq[Temp] := Freq[Temp] + 1
  25.    End;
  26.  Procedure NorDev (Var Y1, Y2 : Real);
  27.    Var V1, V2, S : Real;
  28.    Begin
  29.    { The "Repeat until" loop is repeated 1.27 times 
  30.           on the average with a standard deviation 
  31.           of 0.587 (c.f. D. Knuth (1969), page 104) }
  32.      Repeat
  33.        V1 := 2*Random -1;
  34.        V2 := 2*Random -1;
  35.        S := Sqr(V1) + Sqr(V2)
  36.       until S < 1;
  37.      S := Sqrt(-2*ln(S)/S);
  38.      Y1 := V1*S;
  39.      Y2 := V2*S
  40.    End;
  41.  
  42. Begin
  43.   Initialize;
  44.   For i:= 1 to 5000 do
  45.     Begin
  46.       NorDev(Y1,Y2);
  47.       Classify(Y1);
  48.       Classify(Y2)
  49.     End;
  50.   For i:=0 to 30 do
  51.      Writeln(I:6,Freq[I]:12)
  52. End.
  53.